home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / tk.tcl < prev    next >
Encoding:
Text File  |  1992-08-08  |  10.2 KB  |  291 lines
  1. # tk.tcl --
  2. #
  3. # Initialization script normally executed in the interpreter for each
  4. # Tk-based application.  Arranges class bindings for widgets.
  5. #
  6. # $Header: /user6/ouster/wish/scripts/RCS/tk.tcl,v 1.19 92/08/08 14:50:08 ouster Exp $ SPRITE (Berkeley)
  7. #
  8. # Copyright 1992 Regents of the University of California
  9. # Permission to use, copy, modify, and distribute this
  10. # software and its documentation for any purpose and without
  11. # fee is hereby granted, provided that this copyright
  12. # notice appears in all copies.  The University of California
  13. # makes no representations about the suitability of this
  14. # software for any purpose.  It is provided "as is" without
  15. # express or implied warranty.
  16.  
  17. # Insist on running with a compatible version of Tcl.
  18.  
  19. if "[info tclversion] != {6.4}" {
  20.     error "wrong version of Tcl loaded ([info tclversion]): need 6.4"
  21. }
  22.  
  23. # Initialize the auto-load path to include Tk's directory as well as
  24. # Tcl's directory:
  25.  
  26. set auto_path "$tk_library [info library]"
  27.  
  28. # Turn off strict Motif look and feel as a default.
  29.  
  30. set tk_strictMotif 0
  31.  
  32. # ----------------------------------------------------------------------
  33. # Class bindings for various flavors of button widgets.  $tk_priv(window)
  34. # keeps track of the button containing the mouse, and $tk_priv(relief)
  35. # saves the original relief of the button so it can be restored when
  36. # the mouse button is released.
  37. # ----------------------------------------------------------------------
  38.  
  39. bind Button <Any-Enter> {tk_butEnter %W}
  40. bind Button <Any-Leave> {tk_butLeave %W}
  41. bind Button <1> {tk_butDown %W}
  42. bind Button <ButtonRelease-1> {tk_butUp %W}
  43.  
  44. bind CheckButton <Any-Enter> {tk_butEnter %W}
  45. bind CheckButton <Any-Leave> {tk_butLeave %W}
  46. bind CheckButton <1> {tk_butDown %W}
  47. bind CheckButton <ButtonRelease-1> {tk_butUp %W}
  48.  
  49. bind RadioButton <Any-Enter> {tk_butEnter %W}
  50. bind RadioButton <Any-Leave> {tk_butLeave %W}
  51. bind RadioButton <1> {tk_butDown %W}
  52. bind RadioButton <ButtonRelease-1> {tk_butUp %W}
  53.  
  54. # ----------------------------------------------------------------------
  55. # Class bindings for entry widgets.
  56. # ----------------------------------------------------------------------
  57.  
  58. bind Entry <1> {
  59.     %W cursor @%x
  60.     %W select from @%x
  61.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  62. }
  63. bind Entry <B1-Motion> {%W select to @%x}
  64. bind Entry <Shift-1> {%W select adjust @%x}
  65. bind Entry <Shift-B1-Motion> {%W select to @%x}
  66. bind Entry <2> {%W scan mark %x}
  67. bind Entry <B2-Motion> {%W scan dragto %x}
  68. bind Entry <Any-KeyPress> {
  69.     if {"%A" != ""} {
  70.     %W insert cursor %A
  71.     tk_entrySeeCaret %W
  72.     }
  73. }
  74. bind Entry <Delete> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  75. bind Entry <BackSpace> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  76. bind Entry <Control-h> {tk_entryBackspace %W; tk_entrySeeCaret %W}
  77. bind Entry <Control-d> {%W delete sel.first sel.last; tk_entrySeeCaret %W}
  78. bind Entry <Control-u> {%W delete 0 end}
  79. bind Entry <Control-v> {%W insert cursor [selection get]; tk_entrySeeCaret %W}
  80. bind Entry <Control-w> {tk_entryBackword %W; tk_entrySeeCaret %W}
  81. tk_bindForTraversal Entry
  82.  
  83. # ----------------------------------------------------------------------
  84. # Class bindings for listbox widgets.
  85. # ----------------------------------------------------------------------
  86.  
  87. bind Listbox <1> {%W select from [%W nearest %y]}
  88. bind Listbox <B1-Motion> {%W select to [%W nearest %y]}
  89. bind Listbox <Shift-1> {%W select adjust [%W nearest %y]}
  90. bind Listbox <Shift-B1-Motion> {%W select to [%W nearest %y]}
  91. bind Listbox <2> {%W scan mark %x %y}
  92. bind Listbox <B2-Motion> {%W scan dragto %x %y}
  93.  
  94. # ----------------------------------------------------------------------
  95. # Class bindings for scrollbar widgets.  When strict Motif is requested,
  96. # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
  97. # -activeforeground color to -foreground when the mouse is in the window
  98. # and restore it when the mouse leaves.
  99. # ----------------------------------------------------------------------
  100.  
  101. bind Scrollbar <Any-Enter> {
  102.     if $tk_strictMotif {
  103.     set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
  104.     %W config -activeforeground [lindex [%W config -foreground] 4]
  105.     }
  106. }
  107. bind Scrollbar <Any-Leave> {
  108.     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
  109.     %W config -activeforeground $tk_priv(activeFg)
  110.     }
  111. }
  112. bind Scrollbar <Any-ButtonPress> {incr tk_priv(buttons)}
  113. bind Scrollbar <Any-ButtonRelease> {incr tk_priv(buttons) -1}
  114.  
  115. # ----------------------------------------------------------------------
  116. # Class bindings for scale widgets.  When strict Motif is requested,
  117. # the bindings use $tk_priv(buttons) and $tk_priv(activeFg) to set the
  118. # -activeforeground color to -foreground when the mouse is in the window
  119. # and restore it when the mouse leaves.
  120. # ----------------------------------------------------------------------
  121.  
  122. bind Scale <Any-Enter> {
  123.     if $tk_strictMotif {
  124.     set tk_priv(activeFg) [lindex [%W config -activeforeground] 4]
  125.     %W config -activeforeground [lindex [%W config -sliderforeground] 4]
  126.     }
  127. }
  128. bind Scale <Any-Leave> {
  129.     if {$tk_strictMotif && ($tk_priv(buttons) == 0)} {
  130.     %W config -activeforeground $tk_priv(activeFg)
  131.     }
  132. }
  133. bind Scale <Any-ButtonPress> {incr tk_priv(buttons)}
  134. bind Scale <Any-ButtonRelease> {incr tk_priv(buttons) -1}
  135.  
  136. # ----------------------------------------------------------------------
  137. # Class bindings for menubutton widgets.  Variables used:
  138. # $tk_priv(posted) -        keeps track of the menubutton whose menu is
  139. #                currently posted (or empty string, if none).
  140. # $tk_priv(inMenuButton)-    if non-null, identifies menu button
  141. #                containing mouse pointer.
  142. # $tk_priv(relief) -        keeps track of original relief of posted
  143. #                menu button, so it can be restored later.
  144. # $tk_priv(dragging) -        if non-null, identifies menu button whose
  145. #                menu is currently being dragged in a tear-off
  146. #                operation.
  147. # $tk_priv(focus) -        records old focus window so focus can be
  148. #                returned there after keyboard traversal
  149. #                to menu.
  150. # ----------------------------------------------------------------------
  151.  
  152. bind Menubutton <Enter> {
  153.     set tk_priv(inMenuButton) %W
  154.     if {[lindex [%W config -state] 4] != "disabled"} {
  155.     if {!$tk_strictMotif} {
  156.         %W config -state active
  157.     }
  158.     }
  159. }
  160. bind Menubutton <Any-Leave> {
  161.     set tk_priv(inMenuButton) {}
  162.     if {[lindex [%W config -state] 4] != "disabled"} {
  163.     if {!$tk_strictMotif} {
  164.         %W config -state normal
  165.     }
  166.     }
  167. }
  168. bind Menubutton <1> {tk_mbButtonDown %W}
  169. bind Menubutton <Any-ButtonRelease-1> {
  170.     if {($tk_priv(inMenuButton) != "") && ($tk_priv(posted) != "")} {
  171.     [lindex [$tk_priv(posted) config -menu] 4] activate 0
  172.     } else {
  173.     tk_mbUnpost
  174.     }
  175. }
  176.  
  177. # In the binding below, it's important to ignore grab-related entries
  178. # and exits because they lag reality and can cause menus to chase
  179. # their own tail, repeatedly posting and unposting.
  180.  
  181. bind Menubutton <B1-Enter> {
  182.     set tk_priv(inMenuButton) %W
  183.     if {([lindex [%W config -state] 4] != "disabled")
  184.         && ("%m" != "NotifyGrab") && ("%m" != "NotifyUngrab")} {
  185.     if {!$tk_strictMotif} {
  186.         %W config -state active
  187.     }
  188.     tk_mbPost %W
  189.     }
  190. }
  191. bind Menubutton <2> {
  192.     if {($tk_priv(posted) == "")
  193.         && ([lindex [%W config -state] 4] != "disabled")} {
  194.     set tk_priv(dragging) %W
  195.     [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
  196.     }
  197. }
  198. bind Menubutton <B2-Motion> {
  199.     if {$tk_priv(dragging) != ""} {
  200.     [lindex [$tk_priv(dragging) config -menu] 4] post %X %Y
  201.     }
  202. }
  203. bind Menubutton <ButtonRelease-2> {set tk_priv(dragging) ""}
  204.  
  205. # ----------------------------------------------------------------------
  206. # Class bindings for menu widgets.  $tk_priv(x) and $tk_priv(y) are used
  207. # to keep track of the position of the mouse cursor in the menu window
  208. # during dragging of tear-off menus.  $tk_priv(window) keeps track of
  209. # the menu containing the mouse, if any.
  210. # ----------------------------------------------------------------------
  211.  
  212. bind Menu <Any-Enter> {set tk_priv(window) %W; %W activate @%y}
  213. bind Menu <Any-Leave> {set tk_priv(window) {}; %W activate none}
  214. bind Menu <Any-Motion> {
  215.     if {$tk_priv(window) != ""} {
  216.     %W activate @%y
  217.     }
  218. }
  219. bind Menu <ButtonRelease-1> {tk_invokeMenu %W}
  220. bind Menu <2> {set tk_priv(x) %x; set tk_priv(y) %y}
  221. bind Menu <B2-Motion> {
  222.     if {$tk_priv(posted) == ""} {
  223.     %W post [expr %X-$tk_priv(x)] [expr %Y-$tk_priv(y)]
  224.     }
  225. }
  226. bind Menu <B2-Leave> { }
  227. bind Menu <B2-Enter> { }
  228. bind Menu <Escape> {tk_mbUnpost}
  229. bind Menu <Any-KeyPress> {tk_traverseWithinMenu %W %A}
  230. bind Menu <Left> {tk_nextMenu -1}
  231. bind Menu <Right> {tk_nextMenu 1}
  232. bind Menu <Up> {tk_nextMenuEntry -1}
  233. bind Menu <Down> {tk_nextMenuEntry 1}
  234. bind Menu <Return> {tk_invokeMenu %W}
  235.  
  236. # ----------------------------------------------------------------------
  237. # Class bindings for text widgets. $tk_priv(selectMode) holds one of
  238. # "char", "word", or "line" to indicate which selection mode is active.
  239. # ----------------------------------------------------------------------
  240.  
  241. bind Text <1> {
  242.     set tk_priv(selectMode) char
  243.     %W mark set insert @%x,%y
  244.     %W mark set anchor insert
  245.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  246. }
  247. bind Text <Double-1> {
  248.     set tk_priv(selectMode) word
  249.     %W mark set insert "@%x,%y wordstart"
  250.     tk_textSelectTo %W insert
  251. }
  252. bind Text <Triple-1> {
  253.     set tk_priv(selectMode) line
  254.     %W mark set insert "@%x,%y linestart"
  255.     tk_textSelectTo %W insert
  256. }
  257. bind Text <B1-Motion> {tk_textSelectTo %W @%x,%y}
  258. bind Text <Shift-1> {
  259.     tk_textResetAnchor %W @%x,%y
  260.     tk_textSelectTo %W @%x,%y
  261. }
  262. bind Text <Shift-B1-Motion> {tk_textSelectTo %W @%x,%y}
  263. bind Text <2> {%W scan mark %y}
  264. bind Text <B2-Motion> {%W scan dragto %y}
  265. bind Text <Any-KeyPress> {
  266.     if {"%A" != ""} {
  267.     %W insert insert %A
  268.     %W yview -pickplace insert
  269.     }
  270. }
  271. bind Text <Return> {%W insert insert \n; %W yview -pickplace insert}
  272. bind Text <BackSpace> {tk_textBackspace %W; %W yview -pickplace insert}
  273. bind Text <Delete> {tk_textBackspace %W; %W yview -pickplace insert}
  274. bind Text <Control-h> {tk_textBackspace %W; %W yview -pickplace insert}
  275. bind Text <Control-d> {%W delete sel.first sel.last}
  276. bind Text <Control-v> {
  277.     %W insert insert [selection get]
  278.     %W yview -pickplace insert
  279. }
  280. tk_bindForTraversal Text
  281.  
  282. # Initialize the elements of tk_priv that require initialization.
  283.  
  284. set tk_priv(buttons) 0
  285. set tk_priv(dragging) {}
  286. set tk_priv(focus) {}
  287. set tk_priv(inMenuButton) {}
  288. set tk_priv(posted) {}
  289. set tk_priv(selectMode) char
  290. set tk_priv(window) {}
  291.